home *** CD-ROM | disk | FTP | other *** search
/ Graphics Plus / Graphics Plus.iso / libs / phigs / ptk.lha / ptk / fortran / source / demo / menutest.f < prev    next >
Encoding:
Text File  |  1992-06-18  |  18.4 KB  |  625 lines

  1. C--------------------------------------------------------------------------- 
  2.  
  3. C Program name: Menus test program.
  4.  
  5. C Author: Gareth Williams
  6.  
  7. C Description:
  8.  
  9. C Modification history : (Version), (Date), (Name), (Description).
  10.  
  11. C 1.0, 1st March 1991, G. Williams, First Version.
  12.  
  13. C----------------------------------------------------------------------------
  14.  
  15. C--------------------------------------------------------------------------
  16.  
  17.          PROGRAM menutest
  18.          LOGICAL menuquit, picked
  19.          INTEGER itemnum
  20.          INTEGER ptkf_stringtoint
  21.          LOGICAL ptkf_readphinterscript
  22.          LOGICAL getmenupick
  23.          LOGICAL docolour
  24.         
  25.          include './sunphigs77.h'
  26.          include './sunptk77.h'
  27.  
  28.          implicit undefined (P, p, E, e)
  29.  
  30. C     open PHIGS 
  31.          print *,('Testing the menus utility of the PHIGS Toolkit...')
  32.          print *,('Opening SunPHIGS...')
  33.  
  34.          call popph(6, 0)
  35.  
  36. C     create the workstation type (either tool or canvas) 
  37.               
  38. C     open the workstation 
  39.        
  40.        if (ptkf_readphinterscript('../../scripts/openws.scr', 0, 0) .eq.
  41. & .FALSE.) then     
  42.          goto 20
  43.        endif
  44.  
  45. C     define colour variable
  46. C     for a MONOCHROME workstation set this value to .FALSE.
  47.  
  48.          docolour = .TRUE.
  49.  
  50.          call psdus(1, PWAITD, PNIVE)
  51.        
  52.          call ptkf_inithashtables()
  53.          call ptkf_createhashtable('structureid', 0, 100)
  54.          call ptkf_createhashtable('viewindex', 1, 100)
  55.          call ptkf_createhashtable('label', 0, 100)
  56.          call ptkf_createhashtable('nameset', 0, 100)
  57.          call ptkf_createhashtable('menuid', 1, 100)
  58.          call ptkf_createhashtable('colourindex', 1, 100)
  59.          call ptkf_createhashtable('name', 1, 100)
  60.               
  61. C     set colours 
  62.          if (docolour .eq. .TRUE.) then
  63.            call ptkf_setcolourrep(1, 'black')
  64.            call ptkf_setcolourrep(1, 'GREEN')
  65.            call ptkf_setcolourrep(1, 'white')
  66.            call ptkf_setcolourrep(1, 'MEDIUM GREEN')
  67.            call ptkf_setcolourrep(1, 'MAGENTA')
  68.            call ptkf_setcolourrep(1, 'MEDIUM MAGENTA') 
  69.            call ptkf_setcolourrep(1, 'GREY')
  70.   
  71.            call ptkf_setbackgroundcolourind(1, 
  72. & ptkf_stringtoint('colourindex', 'grey'))
  73.          endif
  74.      
  75. C     menus to select type of menu and type of input 
  76.        
  77.          call makemainmenu(docolour)
  78.        
  79.          call makeinputmenu(docolour)
  80.        
  81. C     create test box, user and rotator menus 
  82.        
  83.          call createbox(docolour)
  84.        
  85.          call createrotator(docolour)
  86.        
  87. C     interaction loop 
  88. C     draw main menu 
  89.        
  90.          menuquit = .FALSE.
  91.  10      call ptkf_postmenu(1, ptkf_stringtoint('menuid', 
  92. & 'mainmenu'))
  93.          call ptkf_unpostmenu(1, ptkf_stringtoint('menuid', 
  94. & 'inputmenu'))    
  95.          call prst(1, PALWAY)
  96.  
  97.          itemnum = 0
  98.          picked = getmenupick(ptkf_stringtoint('menuid', 'mainmenu'), 
  99. & itemnum)
  100.          if (picked .eq. .TRUE.) then
  101.            if (itemnum .eq. 1) then
  102.             call testboxmenu()
  103.            else if (itemnum .eq. 2) then
  104.             call testrotator()
  105.            else
  106.             menuquit = .TRUE.
  107.            endif
  108.          else
  109.            print *,('You didnt pick a menu.')
  110.          endif
  111.  
  112.          if (menuquit .eq. .TRUE.) then
  113.            goto 20
  114.          else 
  115.            goto 10
  116.          endif
  117.  
  118.  20      print *,('Closing PHIGS...')
  119.          call pclwk(1)
  120.          call pclph()
  121.  
  122.          STOP
  123.          END
  124.  
  125. C--------------------------------------------------------------------------
  126.       
  127.          SUBROUTINE pickinput(itemnum)
  128.          INTEGER itemnum, err
  129.          INTEGER menuset(20), emptyset(20), menunames(20)
  130.          INTEGER totsize, i
  131.          REAL pickecho(4)
  132.          INTEGER stat, ppd
  133.          INTEGER pp(3, 20), ppath(3, 20)
  134.          INTEGER ia(2), ldr, err, lstr(1)
  135.          REAL rl(4)
  136.          CHARACTER*80 str, datrec(10)
  137.          LOGICAL picked
  138.          LOGICAL ptkf_pickscanmenus
  139.  
  140.          include './sunphigs77.h'
  141.  
  142.          implicit undefined (P, p, E, e)
  143.  
  144. C test picking 
  145.          itemnum = 0
  146.          print *,('Pick a menu item...')
  147. C initialise pick 
  148.       
  149.          call ptkf_inqpostedmenus(1, 20, menuset, totsize, err)
  150.          do 10, i=1,totsize
  151.            call ptkf_inqmenuname(menuset(i), menunames(i), err)
  152.  10      continue
  153.  
  154.          call pspkft(1, 1, totsize, menunames, 0, emptyset)
  155.       
  156.          call ptkf_limit(0.0, 1.0, 0.0, 1.0, pickecho)
  157.       
  158.          ia(1) = 2
  159.          ia(2) = 2
  160.          rl(1) = 0.3
  161.          rl(2) = 1.0
  162.  
  163.          call pprec(2, ia, 2, rl, 0, lstr, str, 10, err, ldr, datrec)
  164.  
  165.          call pinpk(1, 1, PNPICK, 0, pp, 2, 0.0, 1.0, 0.0, 1.0, 
  166. & ldr, datrec, PPOBOT) 
  167.          
  168. C set pick 
  169.          call pspkm(1, 1, PREQU, PECHO)
  170.          
  171. C request pick 
  172.  
  173.          call prqpk(1, 1, 10, stat, ppd, ppath)
  174.          
  175.          if (stat .eq. POK) then
  176.            picked = ptkf_pickscanmenus(ppd, ppath, PPOBOT, menuid, 
  177. & itemnum) 
  178.            if (picked .eq. .TRUE.) then
  179.              print *,'menu item', itemnum, 'was picked from menu', 
  180. & menuid
  181.            else
  182.              print *,('You did not pick a menu.')
  183.            endif
  184.          else
  185.            print *,('Nothing picked.')
  186.          endif
  187.  
  188.          RETURN
  189.          END
  190.  
  191. C--------------------------------------------------------------------------
  192.          
  193.          LOGICAL FUNCTION getmenupick(menuid, itemnum)
  194.          INTEGER menuid, itemnum, err
  195.          INTEGER pmenuid
  196.          REAL pickecho(4)
  197.          INTEGER menuset(10), emptyset(10)
  198.          INTEGER stat, ppd
  199.          INTEGER pp(3, 20), ppath(3, 20)
  200.          INTEGER ia(2), ldr, err, lstr(1)
  201.          REAL rl(4)
  202.          CHARACTER*80 str, datrec(10)
  203.          LOGICAL ptkf_pickscanmenus
  204.  
  205.          include './sunphigs77.h'
  206.  
  207.          implicit undefined (P, p, E, e)
  208.  
  209. C make menu pickable 
  210.          call ptkf_inqmenuname(menuid, menuset(1), err)
  211.          call pspkft(1, 1, 1, menuset, 0, emptyset)
  212.  
  213.          call ptkf_limit(0.0, 1.0, 0.0, 1.0, pickecho)
  214.       
  215.          ia(1) = 2
  216.          ia(2) = 2
  217.          rl(1) = 0.3
  218.          rl(2) = 1.0
  219.  
  220.          call pprec(2, ia, 2, rl, 0, lstr, str, 10, err, ldr, datrec)
  221.  
  222.          call pinpk(1, 1, PNPICK, 0, pp, 2, 0.0, 1.0, 0.0, 1.0, ldr, 
  223. & datrec, PPOBOT) 
  224.          
  225. C set pick 
  226.          call pspkm(1, 1, PREQU, PECHO)
  227.          
  228. C request pick 
  229.  
  230.          call prqpk(1, 1, 10, stat, ppd, ppath)
  231.          
  232.          if (stat .eq. POK) then
  233.            getmenupick = ptkf_pickscanmenus(ppd, ppath, PPOBOT, 
  234. & pmenuid, itemnum)
  235.          else
  236.            getmenupick = .FALSE.
  237.          endif
  238.  
  239.          RETURN
  240.          END
  241.  
  242. C--------------------------------------------------------------------------
  243.          
  244.          SUBROUTINE pointinput(itemnum)
  245.          INTEGER itemnum
  246.          REAL echovol(4)
  247.          CHARACTER*80 datrec
  248.          INTEGER stat, view
  249.          REAL point(2)
  250.          INTEGER menuid
  251.          REAL value(2)
  252.          LOGICAL picked
  253.          LOGICAL ptkf_locscanmenus
  254.  
  255.          include './sunphigs77.h'
  256.  
  257.          implicit undefined (P, p, E, e)
  258.  
  259.          itemnum = 0
  260.          print *,('Point at a menu item...')
  261.          echovol(1) = 0.0
  262.          echovol(3) = 0.0
  263.          echovol(2) = 1.0
  264.          echovol(4) = 1.0
  265.          call pinlc(1, 1, 0, 0.5, 0.5, 1, 0.0, 1.0, 0.0, 1.0, 0, 
  266. & datrec)
  267.          call pslcm(1, 1, PREQU, PECHO)
  268.          call prqlc(1, 1, stat, view, point(1), point(2))
  269.          if (stat .eq. POK) then
  270.            picked = ptkf_locscanmenus(1, point, menuid, itemnum, 
  271. & value) 
  272.            if (picked .eq. .TRUE.) then
  273.              print *,'menu item', itemnum, 'was pointed at from menu',
  274. & menuid
  275.              print *,'value, x =', value(1), 'y =', value(2)
  276.            endif
  277.          else
  278.            print *,('You did not point at a menu.')
  279.          endif
  280.  
  281.          RETURN
  282.          END
  283.  
  284. C--------------------------------------------------------------------------
  285.          
  286.          SUBROUTINE stringinput(itemnum)
  287.          INTEGER itemnum
  288.          CHARACTER*30 dummystr
  289.          INTEGER dummylen
  290.          REAL echoarea(4)
  291.          LOGICAL picked
  292.          LOGICAL ptkf_stringscanmenus
  293.  
  294.          implicit undefined (P, p, E, e)
  295.  
  296.          itemnum = 0
  297.          print *,('Enter a menu item...')    
  298.          call ptkf_limit(0.0, 0.25, 0.0, 0.01, echoarea)
  299.          call ptkf_readstring(1, '', 'Type menu item name >', echoarea, 
  300. & 30, dummystr, dummylen)
  301.          picked = ptkf_stringscanmenus(1, dummystr, menuid, itemnum)
  302.          if (picked .eq. .TRUE.) then
  303.            print *,'menu item', itemnum, 'was entered from menu', 
  304. & menuid
  305.          else 
  306.            print *,('No menu item of that name.')
  307.          endif
  308.  
  309.          RETURN
  310.          END
  311.  
  312. C--------------------------------------------------------------------------
  313.          
  314.          SUBROUTINE makemainmenu(docolour)
  315.          LOGICAL docolour
  316.          INTEGER err
  317.          REAL topleft(2), box(2)
  318.          INTEGER textind
  319.          REAL charht
  320.          INTEGER white, green, black
  321.          INTEGER mainmenuid
  322.          INTEGER ptkf_stringtoint
  323.  
  324.          include './sunphigs77.h'
  325.  
  326.          implicit undefined (P, p, E, e)
  327.          
  328. C create a BOX menu 
  329. C set up main menu - box menu(box, user, rotator, exit) 
  330.  
  331.          mainmenuid = ptkf_stringtoint('menuid', 'mainmenu') 
  332.          call ptkf_point(0.2, 0.1, box)
  333.          textind = 1
  334.          charht = 0.025
  335.          call ptkf_point(0.8, 1.0, topleft)
  336.  
  337.          call ptkf_createboxmenu(mainmenuid, topleft, box)
  338.  
  339.          if (docolour .eq. .TRUE.) then
  340.            white = ptkf_stringtoint('colourindex', 'white')
  341.            green = ptkf_stringtoint('colourindex', 'green')
  342.            black = ptkf_stringtoint('colourindex', 'black')
  343.            call ptkf_setboxmenuattrs(1, mainmenuid, PDOWN, 1, 
  344. & white, green, green, white, black, white, green, green)
  345.          endif
  346.  
  347.          call ptkf_createtextmenuitem(mainmenuid, 'box', 1, PINSRT, err)
  348.          call ptkf_createtextmenuitem(mainmenuid, 'rotator', 2, PINSRT, 
  349. & err)
  350.          call ptkf_createtextmenuitem(mainmenuid, 'exit', 3, PINSRT, 
  351. & err)
  352.  
  353.          RETURN
  354.          END
  355.  
  356. C--------------------------------------------------------------------------
  357.          
  358.          SUBROUTINE makeinputmenu(docolour)
  359.          LOGICAL docolour
  360.          INTEGER err
  361.          REAL topleft(2), box(2)
  362.          INTEGER textind
  363.          REAL charht
  364.          INTEGER white, magenta, black, darkmagenta
  365.          INTEGER inputmenuid
  366.          INTEGER ptkf_stringtoint
  367.  
  368.          include './sunphigs77.h'
  369.  
  370.          implicit undefined (P, p, E, e)
  371.          
  372.          inputmenuid = ptkf_stringtoint('menuid', 'inputmenu') 
  373.          call ptkf_point(0.2, 0.1, box)
  374.          textind = 1
  375.          charht = 0.03
  376.          call ptkf_point(0.8, 0.5, topleft)
  377.  
  378.          call ptkf_createboxmenu(inputmenuid, topleft, box)
  379.  
  380.          if (docolour .eq. .TRUE.) then
  381.            white = ptkf_stringtoint('colourindex', 'white')
  382.            magenta = ptkf_stringtoint('colourindex', 'magenta')
  383.            darkmagenta = ptkf_stringtoint('colourindex',
  384. & 'medium magenta')
  385.            black = ptkf_stringtoint('colourindex', 'black')
  386.            call ptkf_setboxmenuattrs(1, inputmenuid, PDOWN, 1, 
  387. & white, magenta, magenta, white, black, white, darkmagenta, 
  388. & darkmagenta)
  389.          endif
  390.  
  391.          call ptkf_createtextmenuitem(inputmenuid, 'pick', 1, PINSRT, 
  392. & err)
  393.          call ptkf_createtextmenuitem(inputmenuid, 'point', 2, PINSRT, 
  394. & err)
  395.          call ptkf_createtextmenuitem(inputmenuid, 'string', 3, PINSRT, 
  396. & err)
  397.          call ptkf_createtextmenuitem(inputmenuid, 'exit', 4, PINSRT, 
  398. & err)
  399.  
  400.          RETURN
  401.          END
  402.  
  403. C--------------------------------------------------------------------------
  404.          
  405.          SUBROUTINE createbox(docolour)
  406.          LOGICAL docolour
  407.          INTEGER err
  408.          REAL topleft(2), box(2)
  409.          INTEGER textind
  410.          REAL charht
  411.          INTEGER white, green, black, darkgreen
  412.          INTEGER boxmenuid
  413.          INTEGER ptkf_stringtoint
  414.  
  415.          include './sunphigs77.h'
  416.  
  417.          implicit undefined (P, p, E, e)
  418.          
  419.          boxmenuid = ptkf_stringtoint('menuid', 'boxmenu')
  420.          call ptkf_point(0.2, 0.1, box)
  421.          textind = 1
  422.          charht = 0.03
  423.          call ptkf_point(0.0, 0.0, topleft)
  424.  
  425.          call ptkf_createboxmenu(boxmenuid, topleft, box)
  426.  
  427.          if (docolour .eq. .TRUE.) then
  428.            white = ptkf_stringtoint('colourindex', 'white')
  429.            green = ptkf_stringtoint('colourindex', 'green')
  430.            darkgreen = ptkf_stringtoint('colourindex', 'medium green')
  431.            black = ptkf_stringtoint('colourindex', 'black')
  432.            call ptkf_setboxmenuattrs(1, boxmenuid, PDOWN, 1, 
  433. & white, green, green, white, black, white, darkgreen, darkgreen) 
  434.  
  435.          endif
  436.  
  437.          call ptkf_point(0.5, 0.7, topleft)
  438.          call ptkf_setmenuposition(boxmenuid, topleft)
  439.          
  440.          call ptkf_createtextmenuitem(boxmenuid, 'item 1', 1, PINSRT, 
  441. & err)
  442.          call ptkf_createtextmenuitem(boxmenuid, 'item 2', 2, PINSRT, 
  443. & err)
  444.          call ptkf_createtextmenuitem(boxmenuid, 'item 3', 3, PINSRT, 
  445. & err)
  446.          call ptkf_createtextmenuitem(boxmenuid, 'item 4', 4, PINSRT, 
  447. & err)
  448.          
  449.  
  450.          RETURN
  451.          END
  452.          
  453. C--------------------------------------------------------------------------
  454.                  
  455.          SUBROUTINE createrotator(docolour)
  456.          LOGICAL docolour
  457.          REAL size(2), pos(2)
  458.          INTEGER green, white, black
  459.          INTEGER rotator1, rotator2, rotator3
  460.          INTEGER ptkf_stringtoint
  461.  
  462.          include './sunptk77.h'
  463.  
  464.          implicit undefined (P, p, E, e)
  465.          
  466. C create a rotator 
  467.          rotator1 = ptkf_stringtoint('menuid', '1drotator')
  468.          rotator2 = ptkf_stringtoint('menuid', '2drotator')
  469.          rotator3 = ptkf_stringtoint('menuid', '3drotator')
  470.          call ptkf_point(0.2, 0.2, size)
  471.          call ptkf_createrotator(1, rotator1, PTKEONED, size, 
  472. & '1D rotator', 0.02)
  473.          call ptkf_createrotator(1, rotator2, PTKETWOD, size, 
  474. & '2D rotator', 0.02)
  475.          call ptkf_point(0.3, 0.2, size)
  476.          call ptkf_createrotator(1, rotator3, PTKETHREED, size, 
  477. & '3D rotator', 0.02)
  478.          if (docolour .eq. .TRUE.) then
  479.            green = ptkf_stringtoint('colourindex', 'green')
  480.            white = ptkf_stringtoint('colourindex', 'white')
  481.            black = ptkf_stringtoint('colourindex', 'black')
  482.            call ptkf_setrotatorattrs(1, rotator1, 1, white, green,
  483. & white, green, white, green, white, black)
  484.            call ptkf_setrotatorattrs(1, rotator2, 1, white, green,
  485. & white, green, white, green, white, black)
  486.            call ptkf_setrotatorattrs(1, rotator3, 1, white, green,
  487. & white, green, white, green, white, black)
  488.          endif
  489.  
  490.          call ptkf_point(0.5, 0.3, pos)
  491.          call ptkf_setmenuposition(rotator1, pos)
  492.          call ptkf_point(0.5, 0.55, pos)
  493.          call ptkf_setmenuposition(rotator2, pos)
  494.          call ptkf_point(0.5, 0.8, pos)
  495.          call ptkf_setmenuposition(rotator3, pos)
  496.  
  497.          call ptkf_setrotatortitle(rotator1, 'zoom')
  498.  
  499.          RETURN
  500.          END
  501.          
  502. C--------------------------------------------------------------------------
  503.          
  504.          SUBROUTINE testboxmenu()
  505.          LOGICAL boxmenuquit, picked
  506.          INTEGER itemnum
  507.          LOGICAL getmenupick
  508.          INTEGER ptkf_stringtoint
  509.  
  510.          include './sunphigs77.h'
  511.  
  512.          implicit undefined (P, p, E, e)
  513.  
  514.          call ptkf_unpostmenu(1, ptkf_stringtoint('menuid', 'mainmenu'))  
  515.          call ptkf_postmenu(1, ptkf_stringtoint('menuid', 'inputmenu'))
  516.          call ptkf_postmenu(1, ptkf_stringtoint('menuid', 'boxmenu'))  
  517.  
  518.          call prst(1, PALWAY)
  519.          boxmenuquit = .FALSE.
  520.  
  521.  10      itemnum = 0
  522.          picked = getmenupick(ptkf_stringtoint('menuid', 'inputmenu'), 
  523. & itemnum) 
  524.          if (picked .eq. .TRUE.) then
  525.  
  526.             call ptkf_setboxmenuhighlightitem(ptkf_stringtoint('menuid',
  527. & 'inputmenu'), itemnum)
  528.             call prst(1, PALWAY)
  529.  
  530.             if (itemnum .eq. 1) then
  531.               call pickinput(itemnum)
  532.               call ptkf_setboxmenuhighlightitem(ptkf_stringtoint(
  533. & 'menuid', 'boxmenu'), itemnum)
  534.             else if (itemnum .eq. 2) then
  535.               call pointinput(itemnum)
  536.               call ptkf_setboxmenuhighlightitem(ptkf_stringtoint(
  537. & 'menuid', 'boxmenu'), itemnum)
  538.             else if (itemnum .eq. 3) then
  539.               call stringinput(itemnum)
  540.               call ptkf_setboxmenuhighlightitem(ptkf_stringtoint(
  541. & 'menuid', 'boxmenu'), itemnum)
  542.             else
  543.               boxmenuquit = .TRUE.
  544.             endif
  545.          endif
  546.  
  547.          call prst(1, PALWAY)
  548.  
  549.          if (boxmenuquit .eq. .TRUE.) then
  550.            goto 20
  551.          else 
  552.            goto 10
  553.          endif
  554.  
  555.  20      call ptkf_clearboxmenuhighlight(ptkf_stringtoint('menuid', 
  556. & 'inputmenu'))
  557.          call ptkf_clearboxmenuhighlight(ptkf_stringtoint('menuid', 
  558. & 'boxmenu'))
  559.          call ptkf_unpostmenu(1, ptkf_stringtoint('menuid', 'boxmenu'))
  560.  
  561.          RETURN
  562.          END
  563.             
  564. C--------------------------------------------------------------------------
  565.           
  566.          SUBROUTINE testrotator()
  567.          LOGICAL rotatorquit, picked
  568.          INTEGER err, itemnum
  569.          LOGICAL getmenupick
  570.          INTEGER ptkf_stringtoint
  571.  
  572.          include './sunphigs77.h'
  573.  
  574.          implicit undefined (P, p, E, e)
  575.  
  576.          call ptkf_delmenuitem(ptkf_stringtoint('menuid', 
  577. & 'inputmenu'), 3)
  578.          call ptkf_unpostmenu(1, ptkf_stringtoint('menuid', 
  579. & 'mainmenu'))  
  580.          call ptkf_postmenu(1, ptkf_stringtoint('menuid', 
  581. & 'inputmenu'))
  582.           
  583.          call ptkf_postmenu(1, ptkf_stringtoint('menuid', 
  584. & '1drotator'))
  585.          call ptkf_postmenu(1, ptkf_stringtoint('menuid', 
  586. & '2drotator'))
  587.          call ptkf_postmenu(1, ptkf_stringtoint('menuid', 
  588. & '3drotator'))
  589.          call prst(1, PALWAY)
  590.          rotatorquit = .FALSE.
  591.  10      itemnum = 0
  592.          picked = getmenupick(ptkf_stringtoint('menuid', 'inputmenu'),
  593. & itemnum)
  594.          if (picked .eq. .TRUE.) then
  595.             if (itemnum .eq. 1) then
  596.               call pickinput(itemnum)
  597.             else if (itemnum .eq. 2) then
  598.               call pointinput(itemnum)
  599.             else
  600.               rotatorquit = .TRUE.
  601.             endif
  602.          endif
  603.  
  604.          if (rotatorquit .eq. .TRUE.) then
  605.            goto 20
  606.          else 
  607.            goto 10
  608.          endif
  609.  
  610.  20      call ptkf_unpostmenu(1, ptkf_stringtoint('menuid', 
  611. & '1drotator'))
  612.          call ptkf_unpostmenu(1, ptkf_stringtoint('menuid', 
  613. & '2drotator'))
  614.          call ptkf_unpostmenu(1, ptkf_stringtoint('menuid', 
  615. & '3drotator'))
  616.          call ptkf_createtextmenuitem(ptkf_stringtoint('menuid', 
  617. & 'inputmenu'), 'string', 3, PINSRT, err)
  618.  
  619.          RETURN
  620.          END
  621.           
  622. C--------------------------------------------------------------------------
  623.           
  624. C     end of menutest.f
  625.